home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1992 June: ROMin Holiday / ADC Developer CD (1992-06) (''ROMin Holiday'')_iso / Developer Connection - 06-1992.iso / Development Platforms / LISP Related / U. Mass AI & LISP Tools / UTILITY / UTILITY.lisp < prev   
Encoding:
Text File  |  1990-06-25  |  8.4 KB  |  193 lines  |  [TEXT/MACA]
  1. ; (c) Copyright 1990 by University of Massachusetts. All rights reserved.
  2. ; This software was conceived, designed, and written by Dan Suthers 
  3. ; while supported by the National Science Foundation under grant number
  4. ; MDR 8751362, and by a fellowship from Apple Computer, Inc., Cupertino,
  5. ; CA.  Partial support was also received from the Office of Naval Research
  6. ; under a University Research Initiative Grant, contract N00014-86-K-0764.
  7. ; Mr. Suthers created this software under his own initiative while in an 
  8. ; academic relationship with the University of Massachusetts.  The above
  9. ; copyright notice was a condition placed by University lawyers on approval
  10. ; of distribution of this software by Apple Computer, and is not meant to
  11. ; imply that this software was created in an employment or "work for hire"
  12. ; relationship between the University and Mr. Suthers.
  13. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  14. ; File:         UTILITY.LISP
  15. ; Author:       Dan Suthers
  16. ; Created:      15-Oct-86 01:37:00
  17. ; Modified:     22-Jun-90 01:59:22 (Dan Suthers)
  18. ; Language:     LISP
  19. ; Package:      UTILS
  20. ;
  21. ; Description:  CORAL ALLEGRO (MACINTOSH) VERSION.
  22. ;               General utilities (mostly documentation access), and machine
  23. ;               dependent utilities.  Application specific but machine 
  24. ;               independent utilities have been split into other files.
  25. ;
  26. ; Status:       Should be working.
  27. ;
  28. ; (c) Copyright 1987, by Daniel D. Suthers
  29. ;                        Department of Computer and Information Science
  30. ;                        University of Massachusetts
  31. ;                        Amherst, Massachusetts 01003
  32. ;
  33. ; This software was conceived, designed, and written by Dan Suthers 
  34. ; while supported by the National Science Foundation under grant number
  35. ; MDR 8751362, and by a fellowship from Apple Computer, Inc., Cupertino,
  36. ; CA.  Partial support was also received from the Office of Naval Research
  37. ; under a University Research Initiative Grant, contract N00014-86-K-0764.
  38. ; I wish to acknowledge the generous support of Beverly Woolf, who obtained 
  39. ; the above grants and encouraged me to pursue my own research interests in
  40. ; her lab.  This work would not have been possible without the resources and
  41. ; stimulating environment of the Computer and Information Science department.
  42. ;
  43. ; Permission to use, modify, and distribute this software is granted subject 
  44. ; to the following restrictions and understandings:
  45. ; 1. The file header, including this notice, shall be retained, and may be
  46. ;    extended to include documentation of modifications to the software.
  47. ; 2. This material is for nonprofit educational and research purposes only.
  48. ;    Users are requested, but not required, to inform Mr. Suthers of any 
  49. ;    noteworthy uses of this software.
  50. ; 3. Mr. Suthers and the University of Massachusetts make no warrantee or
  51. ;    representation that the operation of this software will be error free,
  52. ;    and are under no obligation to provide any services.
  53. ; 4. Any user of such software agrees to indemnify and hold harmless Mr.
  54. ;    Suthers and the University of Massachusetts from all claims arising 
  55. ;    out of the use or misuse of this software, or arising out of any 
  56. ;    accident, injury, or damage whatsoever, and from all costs, counsel
  57. ;    fees, and liabilities incurred in or about any such claim, action, or
  58. ;    proceeding brought thereon.
  59. ; 5. All materials and reports developed as a consequence of the use of 
  60. ;    this software shall duly acknowledge such use, in accordance with
  61. ;    the usual standards of acknowledging credit in academic research.
  62. ;
  63. ;
  64. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  65.  
  66. (in-package :UTILS :use '(lisp))
  67.  
  68. (export '(
  69.       DATE-AND-TIME-STRING
  70.     #+VAX DCL
  71.           DOC
  72.           DOC*
  73.           PDOC
  74.    #+:CCL USE-PACKAGE!
  75.       WHEREIS
  76.   ))
  77.  
  78. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  79.  
  80. (defun DATE-AND-TIME-STRING ()
  81.   "date-and-time-string                                             [Function]
  82.   Returns a string of the current date/time in the format 01-Jan-99 12:34:45"
  83.   (multiple-value-bind
  84.     (second minute hour date month year)
  85.     (get-decoded-time)
  86.     (format nil "~2,'0D-~A-~2,'0D ~2,'0D:~2,'0D:~2,'0D"
  87.         date 
  88.             (case month
  89.               ((1) "Jan")
  90.               ((2) "Feb")
  91.               ((3) "Mar")
  92.               ((4) "Apr")
  93.               ((5) "May")
  94.               ((6) "Jun")
  95.               ((7) "Jul")
  96.               ((8) "Aug")
  97.               ((9) "Sep")
  98.               ((10) "Oct")
  99.               ((11) "Nov")
  100.               ((12) "Dec"))
  101.             (- year 1900)
  102.             hour minute second)))
  103.  
  104. #+VAX
  105. (defun DCL (command-string)
  106.   "dcl <command-string>                                             [Function]
  107.   Spawns a VMS DCL process to execute the command."
  108.   (spawn :command-string command-string))
  109.  
  110. (defun DOC* (sym &key (stream *standard-output*))
  111.   "doc* sym &key (stream *standard-output*)                         [Function]
  112.   Prints function and/or variable documentation of the indicated symbol to
  113.   <stream>.  Returns nil, unless <stream> is nil, in which case a string is
  114.   returned instead of printing."
  115.   (let* ((fundoc (if (fboundp sym) (documentation sym 'function)))
  116.          (vardoc (if (boundp sym)  (documentation sym 'variable)))
  117.          (doc-string
  118.           (with-output-to-string (s)
  119.             (cond ((and fundoc vardoc)
  120.                    (format s "~S~% Function:~%  ~A~% Variable:~%  ~A" 
  121.                            sym fundoc vardoc))
  122.                   (fundoc 
  123.                    (format s "~S~% Function:~%  ~A" sym fundoc))
  124.                   (vardoc
  125.                    (format s "~S~% Variable:~%  ~A" sym vardoc))
  126.                   (T
  127.                    (format s "~S Exported but undocumented ~A."
  128.                            sym
  129.                            (if (fboundp sym)
  130.                              "Function" "Variable")))))))
  131.     (if stream (format stream "~A" doc-string) doc-string)))
  132.  
  133.  
  134. (defmacro DOC (sym &key (stream *standard-output*))
  135.   "doc sym &key (stream *standard-output*)                             [Macro]
  136.   Prints function and/or variable documentation of the indicated symbol to
  137.   <stream>.  Returns nil, unless <stream> is nil, in which case a string is
  138.   returned instead of printing.  Only the second argument is evaluated (see
  139.   DOC* for functional version)."
  140.   "doc <fsymbol>                                                       [Macro]
  141.   Prints documentation of a function."
  142.   `(doc* ',sym :stream ',stream))
  143.  
  144. (defmacro PDOC (package-name &key (stream *standard-output*))
  145.   "pdoc <package-name> &key (stream *standard-output*)                 [Macro] 
  146.    Prints all documentation of all exported symbols in a package.
  147.    See DOC for details; the only difference is this won't return 
  148.    a string collecting all the results if <stream> is nil."
  149.   `(let* ((*package* (or (find-package (string ',package-name))
  150.                         (warn "There is no package called ~S" package-name)))
  151.           (symbols nil))
  152.  
  153.      (when *package*
  154.        (format T
  155.            "~%
  156. ------------------------------------------------------------------------------
  157. Documentation for Exported Symbols in Package ~A:"
  158.            ',package-name)
  159.        (do-external-symbols (sym *package*)
  160.          (push sym symbols))
  161.        (dolist (sym (sort symbols 
  162.                           #'(lambda (s1 s2)
  163.                               (string< (symbol-name s1) (symbol-name s2)))))
  164.          (format ',stream "~%~%")
  165.          (doc* sym :stream ',stream)))))
  166.  
  167.  
  168. #+:CCL
  169. (defun USE-PACKAGE! (package)
  170.   "use-package! <package>                                              [Macro]
  171.   Just like use-package, but forces use by uninterning possible conflicts 
  172.   first.  This is needed in Allegro because a symbol conflict is not a
  173.   continuable error."
  174.   (do-external-symbols (sym package)
  175.      (if (find-symbol (symbol-name sym) *package*)
  176.        (unintern (find-symbol (symbol-name sym) *package*) *package*)))
  177.   (use-package package))
  178.  
  179. (defmacro WHEREIS (SYM)
  180.   "whereis <symbol>                                                    [Macro]
  181.   Finds and prints all packages a symbol is in."
  182.   `(dolist (p (list-all-packages))
  183.      (if (find-symbol ',(symbol-name sym) p) 
  184.        (progn 
  185.          (format T "; ~A" p)
  186.          (if (eq p *package*) 
  187.            (format T " (the current package)"))))))
  188.  
  189. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  190. (provide :utility)
  191. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  192. ;;; EOF
  193.